home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / util / cdity / IFX.lha / IFX / prefs / ifx.e < prev    next >
Text File  |  1997-12-03  |  31KB  |  1,284 lines
  1. ->
  2. -> prefs.e
  3. ->
  4. -> An attempt at using GadTools to do the IFX preferences 
  5. -> program.
  6. ->
  7.  
  8. -> Modules
  9. MODULE 'dos',        'dos/dos',        'dos/dosextens',    'dos/dostags'
  10. MODULE 'asl',        'libraries/asl'
  11. MODULE 'intuition', 'intuition/intuition', 'intuition/gadgetclass',
  12.         'intuition/screens'
  13. MODULE 'graphics',  'graphics/text'
  14. MODULE 'gadtools',  'libraries/gadtools'
  15. MODULE 'exec/ports'
  16. MODULE 'utility/tagitem'
  17.  
  18. MODULE 'exec/obj/list',     'exec/obj/node'
  19. MODULE 'other/split'
  20. MODULE '*/modules/action',    '*/speak/speak'
  21. MODULE 'amigalib/tasks'
  22. MODULE 'tools/sound'
  23. MODULE 'fabio/rxobj_oo'
  24.  
  25. ->
  26. -> Object definitions
  27. ->
  28.  
  29.     -> ID
  30.     
  31. OBJECT ifx_id OF node
  32.     list    :PTR TO list        -> Action list
  33. ENDOBJECT
  34.  
  35.     -> Action
  36.  
  37. OBJECT ifx_action OF node
  38.     type        :PTR TO CHAR
  39. ENDOBJECT
  40.     
  41. -> Gadget ID's
  42. ENUM LV_IDS,
  43.      LV_ACTS,
  44.      BUT_DONE,
  45.      BUT_SAVE,
  46.      BUT_CANCEL,
  47.      BUT_ADDID,
  48.      BUT_REMID,
  49.      BUT_ADDACT,
  50.      BUT_REMACT,
  51.      BUT_OKAYID,
  52.      BUT_OKAYACT,
  53.      BUT_CANCELACT,
  54.      BUT_FILEREQ,
  55.      BUT_TESTACT,
  56.      BUT_EDITIDS,
  57.      STR_INFO,
  58.      STR_ID,
  59.      STR_DIR,
  60.      CY_TYPE,
  61.      ID_DUMMY
  62.  
  63.     -> Gadget objects
  64. DEF    lv_ids        :PTR TO gadget,
  65.     lv_acts        :PTR TO gadget,
  66.     but_save    :PTR TO gadget,
  67.     but_cancel    :PTR TO gadget,
  68.     but_done    :PTR TO gadget,
  69.     but_okayid    :PTR TO gadget,
  70.     but_addid    :PTR TO gadget,
  71.     but_remid    :PTR TO gadget,
  72.     but_addact    :PTR TO gadget,
  73.     but_remact    :PTR TO gadget,
  74.     but_filereq    :PTR TO gadget,
  75.     but_testact    :PTR TO gadget,
  76.     str_info    :PTR TO gadget,
  77.     str_id        :PTR TO gadget,
  78.     str_dir        :PTR TO gadget,
  79.     cy_type        :PTR TO gadget,
  80.     but_okayact    :PTR TO gadget
  81.     
  82. -> Global variables
  83.     -> Font
  84. DEF topaz80:PTR TO textattr
  85.  
  86.     -> Sounds
  87. DEF sounds:PTR TO LONG, curr
  88.  
  89.     -> Ids
  90. DEF ids:PTR TO list
  91.  
  92.     -> Port
  93. DEF g_mp:PTR TO mp
  94.     
  95.     -> Current ID and Action
  96. DEF id_curr:PTR TO ifx_id, act_curr:PTR TO ifx_action
  97.  
  98.     -> Last directory name
  99. DEF last_dir:PTR TO CHAR, def_dir:PTR TO CHAR
  100.  
  101.     -> ASL Requester
  102. DEF asl:PTR TO filerequester
  103.  
  104.     -> Directory locks
  105. DEF olddir, curdir
  106.  
  107. -> MAIN
  108. PROC main() HANDLE
  109.     DEF font
  110.     
  111.     -> First, find our current directory
  112.     olddir := CurrentDir(NIL)
  113.     
  114.     -> Allocate sounds space
  115.     NEW sounds[2]
  116.     
  117.     -> Create our ids list
  118.     NEW ids.init()
  119.     IF ids=NIL THEN Throw("MEM", ' (for IDS list)')
  120.     
  121.     -> Create our global message port
  122.     g_mp := CreateMsgPort()
  123.     IF g_mp=NIL THEN Throw("INIT", ' (message port)')
  124.     
  125.     -> Load the configuration
  126.     IF load_config() THEN put_error('Unable to open prefs file.\n')
  127.     
  128.     -> Open ASL
  129.     IF aslbase=NIL THEN aslbase := OpenLibrary('asl.library', 37)
  130.     IF aslbase=NIL /* Still */ THEN RETURN FALSE
  131.     
  132.     -> Open Gadtools
  133.     IF gadtoolsbase=NIL THEN gadtoolsbase := OpenLibrary('gadtools.library', 37)
  134.     IF gadtoolsbase=NIL /* Still */ THEN RETURN FALSE
  135.     
  136.     -> Open Datatypes
  137.     IF datatypesbase=NIL THEN datatypesbase := OpenLibrary('datatypes.library', 0)
  138.     
  139.     -> Initialize some stuff
  140.     topaz80 := ['topaz.font', 8, 0, 0]:textattr            -> Default font
  141.     
  142.     -> Create the ASL requester here!
  143.     asl := AllocAslRequest(ASL_FILEREQUEST,
  144.             [ASL_HAIL,            'Select A File',
  145.              NIL,                NIL])
  146.  
  147.     -> Open the font, to make sure it's possible
  148.     IF (font := OpenFont(topaz80))<>NIL
  149.         -> Do the stuff
  150.         dowindow({maingadgets})
  151.         
  152.         -> Close the font
  153.         CloseFont(font)
  154.     ELSE
  155.         put_error('Unable to open topaz font!\n')
  156.     ENDIF    
  157.  
  158.     IF asl THEN FreeAslRequest(asl)
  159.         
  160. EXCEPT DO
  161.     IF font            THEN CloseFont(font)
  162.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  163.     gadtoolsbase := NIL
  164.     IF aslbase        THEN CloseLibrary(aslbase)
  165.     aslbase := NIL
  166.     IF datatypesbase THEN CloseLibrary(datatypesbase)
  167.     datatypesbase := NIL
  168.     IF olddir THEN CurrentDir(olddir)
  169.     IF curdir THEN UnLock(curdir)
  170. ENDPROC
  171.  
  172. PROC dowindow(makegadgets)
  173.     DEF myscr        :PTR TO screen,
  174.         mywin        :PTR TO window,
  175.         glist        :PTR TO gadget,
  176.         gad            :LONG,
  177.         userdata    :LONG,
  178.         done=0        :LONG,
  179.         vi            :LONG
  180.         
  181.  
  182.     -> Lock the public screen
  183.     IF (myscr := LockPubScreen(NIL))<>NIL
  184.         -> Get visual info
  185.         IF (vi := GetVisualInfoA(myscr, [TAG_END, NIL]))<>NIL
  186.             gad := makegadgets(myscr, vi, {glist})
  187.             IF gad
  188.                 -> Open the window
  189.                 IF (mywin := OpenWindowTagList(NIL,
  190.                         [WA_TITLE,        'IFX Preferences V2.00',
  191.                          WA_GADGETS,            glist,
  192.                          WA_AUTOADJUST,         TRUE,
  193.                          WA_WIDTH,                480,
  194.                          WA_INNERHEIGHT,        130,
  195.                          WA_DRAGBAR,            1,
  196.                          WA_CLOSEGADGET,        1,
  197.                          WA_DEPTHGADGET,        1,
  198.                          WA_ACTIVATE,            1,
  199.                          WA_SIMPLEREFRESH,        1,
  200.                          WA_IDCMP,            IDCMP_CLOSEWINDOW OR
  201.                                              IDCMP_REFRESHWINDOW OR
  202.                                              IDCMP_VANILLAKEY OR
  203.                                              LISTVIEWIDCMP OR
  204.                                              BUTTONIDCMP OR
  205.                                              STRINGIDCMP OR
  206.                                              CYCLEIDCMP,
  207.                          WA_PUBSCREEN,             myscr,
  208.                          NIL,                     NIL]))<>NIL
  209.                     
  210.                     -> Set userdata
  211.                     mywin.userdata := makegadgets
  212.  
  213.                     -> Refresh the gadgets
  214.                     Gt_RefreshWindow(mywin, NIL)
  215.                     
  216.                     WHILE done=NIL
  217.                         
  218.                         -> Do that gadget/message THANG..
  219.                         makegadgets := handlewindow(mywin, userdata)
  220.                         
  221.                         IF makegadgets
  222.                             -> Free up the old gadgets
  223.                             RemoveGList(mywin, glist, 0)
  224.                             FreeGadgets(glist)
  225.                             
  226.                             -> Make the new gadgets
  227.                             gad := makegadgets(myscr, vi, {glist})
  228.                             IF gad
  229.                                 -> Add the gadgets
  230.                                 AddGList( mywin, glist, -1, -1, NIL ) 
  231.                                 
  232.                                 -> Erase the old gadgets
  233.                                 EraseRect(mywin.rport, mywin.borderleft, mywin.bordertop, mywin.width-mywin.borderright-1, mywin.height-mywin.borderbottom-1)
  234.                                 
  235.                                 -> Draw the new ones
  236.                                 RefreshGadgets(glist, mywin, NIL)
  237.                                 
  238.                                 -> Refresh'em for fun!
  239.                                 Gt_RefreshWindow(mywin, NIL)
  240.                             ELSE
  241.                                 done := 1
  242.                             ENDIF
  243.                         ELSE
  244.                             done := 1
  245.                         ENDIF
  246.                     ENDWHILE
  247.                     
  248.                     -> Close the window
  249.                     CloseWindow(mywin)
  250.                  ELSE
  251.                      put_error('Unable to open window!\n')
  252.                  ENDIF
  253.             ELSE
  254.                 put_error('Unable to create gadgets!\n')
  255.             ENDIF
  256.                 FreeGadgets(glist)
  257.                 FreeVisualInfo(vi)
  258.         ELSE
  259.             put_error('Unable to get visual info!\n')
  260.             ENDIF
  261.             
  262.         UnlockPubScreen(NIL, myscr)
  263.     ELSE
  264.         put_error('Unable to lock public screen!\n')
  265.     ENDIF
  266. ENDPROC
  267.  
  268.  
  269. PROC handlewindow(win:PTR TO window, userdata)
  270.     DEF imsg:PTR TO intuimessage,
  271.         class, code, id, object, gad:PTR TO gadget,
  272.         ifx:PTR TO ifx_id, act:PTR TO ifx_action,
  273.         rx:PTR TO rxobj,
  274.         obj:PTR TO node,
  275.         thwin:PTR TO window,
  276.         temp:PTR TO CHAR,
  277.         done=NIL
  278.     
  279.  
  280.     WHILE done=NIL
  281.         WaitPort(win.userport)
  282.         WHILE (imsg := Gt_GetIMsg(win.userport))<>NIL
  283.             class  := imsg.class
  284.             code   := imsg.code
  285.             object := imsg.iaddress
  286.             thwin  := imsg.idcmpwindow
  287.             
  288.             SELECT class
  289.                 CASE IDCMP_REFRESHWINDOW
  290.                     -> Refresh the window and its gadgets
  291.                     Gt_BeginRefresh(thwin)
  292.                     Gt_EndRefresh(thwin, 1)
  293.                 
  294.                 CASE IDCMP_GADGETDOWN
  295.                 CASE IDCMP_MOUSEMOVE
  296.                 CASE IDCMP_GADGETUP
  297.                     gad := object
  298.                     id := gad.gadgetid
  299.                     
  300.                     gadgethit:
  301.                     
  302.                     SELECT id
  303.                         CASE LV_IDS
  304.                             IF lv_ids THEN killlist(lv_ids, win)
  305.                             id_curr := entrynum(ids, code)
  306.                             done := {idgadgets}
  307.                             
  308.                         CASE LV_ACTS
  309.                             IF id_curr
  310.                                 IF lv_acts THEN killlist(lv_acts, win)
  311.                                 act_curr := entrynum(id_curr.list, code)
  312.                                 done := {actgadgets}
  313.                             ENDIF
  314.                             
  315.                         CASE BUT_DONE
  316.                             done := {maingadgets}
  317.                                 
  318.                         CASE BUT_SAVE
  319.                             -> Save the config
  320.                             IF save_config()=-1 THEN put_error('Save failed!')
  321.                             
  322.                             -> Inform IFX
  323.                             NEW rx.rxobj('IFXPREFS')
  324.                             rx.send('PLAY', 'prefs', NIL, NIL)
  325.                             END rx
  326.                             done := -1
  327.                              
  328.                         CASE BUT_CANCEL
  329.                             IF ask('Are you sure you want\nto exit without saving?', win)
  330.                                 -> Yes
  331.                                 done := -1
  332.                             ELSE
  333.                                 -> No
  334.                             ENDIF    
  335.                         
  336.                         CASE BUT_OKAYID
  337.                             IF id_curr AND str_id
  338.                                 -> Read the new string
  339.                                 END id_curr.name
  340.                                 
  341.                                 obj := str_id.specialinfo::stringinfo.buffer
  342.                                 IF obj
  343.                                     NEW id_curr.name[StrLen(obj)+1]
  344.                                     StrCopy(id_curr.name, obj)
  345.                                 ENDIF
  346.                                 
  347.                                 -> Nullify the id
  348.                                 id_curr := NIL
  349.                             ELSE
  350.                                 put_error('DEBUG: Error @ 289')
  351.                             ENDIF
  352.                             done := {idsgadgets}
  353.  
  354.                         CASE BUT_ADDID
  355.                             killlist(lv_ids, win)
  356.                             id_curr := newid('new_id')
  357.